Windows Game Programming for Dummies (2nd Edition)

home *** CD-ROM | disk | FTP | other *** search

/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectInput / Feedback / ForceFeedback.frm (.txt) next >

Wrap

Visual Basic Form | 2001-10-08 | 65.3 KB | 1,390 lines

VERSION 5.00 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Begin VB.Form frmForceFeedback BorderStyle = 3 'Fixed Dialog Caption = "VB Force Feedback" ClientHeight = 7020 ClientLeft = 45 ClientTop = 330 ClientWidth = 9315 Icon = "ForceFeedback.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 7020 ScaleWidth = 9315 StartUpPosition = 2 'CenterScreen Begin VB.Frame frameDirection Caption = "Direction" Height = 2895 Left = 6720 TabIndex = 70 Top = 3960 Width = 2415 Begin VB.OptionButton optDirection Caption = "Option1" Height = 210 Index = 0 Left = 1080 TabIndex = 78 Top = 480 Value = -1 'True Width = 200 End Begin VB.OptionButton optDirection Caption = "Option2" Height = 210 Index = 4 Left = 1080 TabIndex = 77 Top = 2280 Width = 200 End Begin VB.OptionButton optDirection Caption = "Option3" Height = 210 Index = 6 Left = 240 TabIndex = 76 Top = 1380 Width = 200 End Begin VB.OptionButton optDirection Caption = "Option4" Height = 210 Index = 2 Left = 1920 TabIndex = 75 Top = 1320 Width = 200 End Begin VB.OptionButton optDirection Caption = "Option5" Height = 210 Index = 7 Left = 480 TabIndex = 74 Top = 840 Width = 200 End Begin VB.OptionButton optDirection Caption = "Option6" Height = 210 Index = 1 Left = 1680 TabIndex = 73 Top = 840 Width = 200 End Begin VB.OptionButton optDirection Caption = "Option7" Height = 210 Index = 5 Left = 480 TabIndex = 72 Top = 1920 Width = 200 End Begin VB.OptionButton optDirection Caption = "Option8" Height = 210 Index = 3 Left = 1680 TabIndex = 71 Top = 1920 Width = 200 End End Begin VB.Frame frameEnvelope Caption = "Envelope" Height = 2895 Left = 3720 TabIndex = 56 Top = 3960 Width = 2775 Begin MSComctlLib.Slider sldEnvelope Height = 255 Index = 0 Left = 240 TabIndex = 58 Top = 855 Width = 2295 _ExtentX = 4048 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 SelStart = 10000 TickFrequency = 1000 Value = 10000 End Begin VB.CheckBox chkEnvelope Caption = "Use envelope" Height = 255 Left = 720 TabIndex = 57 Top = 280 Width = 1335 End Begin MSComctlLib.Slider sldEnvelope Height = 255 Index = 1 Left = 240 TabIndex = 59 Top = 1380 Width = 2295 _ExtentX = 4048 _ExtentY = 450 _Version = 393216 LargeChange = 10000 SmallChange = 1000 Max = 5000000 TickFrequency = 500000 End Begin MSComctlLib.Slider sldEnvelope Height = 255 Index = 2 Left = 240 TabIndex = 60 Top = 1965 Width = 2295 _ExtentX = 4048 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 SelStart = 10000 TickFrequency = 1000 Value = 10000 End Begin MSComctlLib.Slider sldEnvelope Height = 255 Index = 3 Left = 240 TabIndex = 61 Top = 2520 Width = 2295 _ExtentX = 4048 _ExtentY = 450 _Version = 393216 LargeChange = 1000 SmallChange = 100 Max = 5000000 TickFrequency = 500000 End Begin VB.Label lblEnvelope AutoSize = -1 'True Caption = "0" Height = 195 Index = 3 Left = 1440 TabIndex = 69 Top = 2325 Width = 90 End Begin VB.Label lblEnvelope AutoSize = -1 'True Caption = "10000" Height = 195 Index = 2 Left = 1440 TabIndex = 68 Top = 1740 Width = 450 End Begin VB.Label lblEnvelope AutoSize = -1 'True Caption = "0" Height = 195 Index = 1 Left = 1440 TabIndex = 67 Top = 1170 Width = 90 End Begin VB.Label lblEnvelope AutoSize = -1 'True Caption = "10000" Height = 195 Index = 0 Left = 1440 TabIndex = 66 Top = 600 Width = 450 End Begin VB.Label Label20 AutoSize = -1 'True Caption = "Fade Time:" Height = 195 Left = 510 TabIndex = 65 Top = 2325 Width = 795 End Begin VB.Label Label19 AutoSize = -1 'True Caption = "Fade Level:" Height = 195 Left = 465 TabIndex = 64 Top = 1740 Width = 840 End Begin VB.Label Label18 AutoSize = -1 'True Caption = "Attack Time:" Height = 195 Left = 405 TabIndex = 63 Top = 1170 Width = 900 End Begin VB.Label Label17 AutoSize = -1 'True Caption = "Attack Level:" Height = 195 Left = 360 TabIndex = 62 Top = 600 Width = 945 End End Begin VB.Frame frameTypeContainer Caption = "Type-Specific Parameters" Height = 3495 Left = 3720 TabIndex = 12 Top = 240 Width = 5415 Begin VB.Frame frameCondition Caption = "Conditional Force" Height = 3015 Left = 120 TabIndex = 37 Top = 240 Visible = 0 'False Width = 5175 Begin VB.OptionButton optConditionAxis Caption = "Y Axis" Height = 255 Index = 1 Left = 2280 TabIndex = 80 Top = 2700 Width = 735 End Begin VB.OptionButton optConditionAxis Caption = "X Axis" Height = 255 Index = 0 Left = 2280 TabIndex = 79 Top = 2440 Value = -1 'True Width = 735 End Begin MSComctlLib.Slider sldCondition Height = 255 Index = 0 Left = 240 TabIndex = 38 Top = 600 Width = 2055 _ExtentX = 3625 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldCondition Height = 255 Index = 1 Left = 240 TabIndex = 39 Top = 1320 Width = 2055 _ExtentX = 3625 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Min = -10000 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldCondition Height = 255 Index = 2 Left = 240 TabIndex = 40 Top = 2160 Width = 2055 _ExtentX = 3625 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 SelStart = 10000 TickFrequency = 1000 Value = 10000 End Begin MSComctlLib.Slider sldCondition Height = 255 Index = 3 Left = 2880 TabIndex = 41 Top = 600 Width = 2055 _ExtentX = 3625 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Min = -10000 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldCondition Height = 255 Index = 4 Left = 2880 TabIndex = 42 Top = 1320 Width = 2055 _ExtentX = 3625 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Min = -10000 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldCondition Height = 255 Index = 5 Left = 2880 TabIndex = 43 Top = 2160 Width = 2055 _ExtentX = 3625 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 SelStart = 10000 TickFrequency = 1000 Value = 10000 End Begin VB.Label Label11 AutoSize = -1 'True Caption = "Dead band:" Height = 195 Left = 240 TabIndex = 55 Top = 360 Width = 840 End Begin VB.Label Label12 AutoSize = -1 'True Caption = "Negative Coefficient:" Height = 195 Left = 240 TabIndex = 54 Top = 1080 Width = 1455 End Begin VB.Label Label13 AutoSize = -1 'True Caption = "Negative Saturation:" Height = 195 Left = 240 TabIndex = 53 Top = 1920 Width = 1455 End Begin VB.Label Label14 AutoSize = -1 'True Caption = "Offset:" Height = 195 Left = 3120 TabIndex = 52 Top = 360 Width = 465 End Begin VB.Label Label15 AutoSize = -1 'True Caption = "Positive Coefficient:" Height = 195 Left = 3000 TabIndex = 51 Top = 1080 Width = 1365 End Begin VB.Label Label16 AutoSize = -1 'True Caption = "Positive Saturation:" Height = 195 Left = 3000 TabIndex = 50 Top = 1920 Width = 1365 End Begin VB.Label lblCondition AutoSize = -1 'True Caption = "0" Height = 195 Index = 0 Left = 1200 TabIndex = 49 Top = 360 Width = 90 End Begin VB.Label lblCondition AutoSize = -1 'True Caption = "0" Height = 195 Index = 1 Left = 1800 TabIndex = 48 Top = 1080 Width = 90 End Begin VB.Label lblCondition AutoSize = -1 'True Caption = "10000" Height = 195 Index = 2 Left = 1800 TabIndex = 47 Top = 1920 Width = 450 End Begin VB.Label lblCondition AutoSize = -1 'True Caption = "0" Height = 195 Index = 3 Left = 3600 TabIndex = 46 Top = 360 Width = 90 End Begin VB.Label lblCondition AutoSize = -1 'True Caption = "0" Height = 195 Index = 4 Left = 4440 TabIndex = 45 Top = 1080 Width = 90 End Begin VB.Label lblCondition AutoSize = -1 'True Caption = "10000" Height = 195 Index = 5 Left = 4410 TabIndex = 44 Top = 1920 Width = 450 End End Begin VB.Frame framePeriodic Caption = "Periodic Force" Height = 3015 Left = 120 TabIndex = 24 Top = 240 Visible = 0 'False Width = 5175 Begin MSComctlLib.Slider sldPeriodic Height = 255 Index = 0 Left = 600 TabIndex = 25 Top = 480 Width = 4095 _ExtentX = 7223 _ExtentY = 450 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldPeriodic Height = 255 Index = 1 Left = 600 TabIndex = 26 Top = 1080 Width = 4095 _ExtentX = 7223 _ExtentY = 450 _Version = 393216 LargeChange = 1000 SmallChange = 100 Min = -10000 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldPeriodic Height = 255 Index = 2 Left = 600 TabIndex = 27 Top = 1800 Width = 4095 _ExtentX = 7223 _ExtentY = 450 _Version = 393216 LargeChange = 1000 SmallChange = 100 Max = 35999 TickFrequency = 1000 End Begin MSComctlLib.Slider sldPeriodic Height = 255 Index = 3 Left = 600 TabIndex = 28 Top = 2520 Width = 4095 _ExtentX = 7223 _ExtentY = 450 _Version = 393216 LargeChange = 1000 SmallChange = 100 Max = 500000 TickFrequency = 10000 End Begin VB.Label lblPeriodic AutoSize = -1 'True Caption = "0" Height = 195 Index = 3 Left = 2400 TabIndex = 36 Top = 2280 Width = 90 End Begin VB.Label Label10 AutoSize = -1 'True Caption = "Period:" Height = 195 Left = 1800 TabIndex = 35 Top = 2280 Width = 495 End Begin VB.Label lblPeriodic AutoSize = -1 'True Caption = "0" Height = 195 Index = 2 Left = 2400 TabIndex = 34 Top = 1560 Width = 90 End Begin VB.Label Label9 AutoSize = -1 'True Caption = "Phase:" Height = 195 Left = 1800 TabIndex = 33 Top = 1560 Width = 495 End Begin VB.Label lblPeriodic AutoSize = -1 'True Caption = "0" Height = 195 Index = 1 Left = 2400 TabIndex = 32 Top = 840 Width = 90 End Begin VB.Label Label8 AutoSize = -1 'True Caption = "Offset:" Height = 195 Left = 1800 TabIndex = 31 Top = 840 Width = 465 End Begin VB.Label lblPeriodic AutoSize = -1 'True Caption = "0" Height = 195 Index = 0 Left = 2400 TabIndex = 30 Top = 240 Width = 90 End Begin VB.Label Label7 AutoSize = -1 'True Caption = "Magnitude:" Height = 195 Left = 1560 TabIndex = 29 Top = 240 Width = 795 End End Begin VB.Frame frameRampForce Caption = "Ramp Force" Height = 3015 Left = 120 TabIndex = 17 Top = 240 Width = 5175 Begin MSComctlLib.Slider sldRampRange Height = 495 Index = 0 Left = 480 TabIndex = 18 Top = 840 Width = 4215 _ExtentX = 7435 _ExtentY = 873 _Version = 393216 LargeChange = 1000 SmallChange = 100 Min = -10000 Max = 10000 TickFrequency = 1000 End Begin MSComctlLib.Slider sldRampRange Height = 495 Index = 1 Left = 480 TabIndex = 19 Top = 1920 Width = 4215 _ExtentX = 7435 _ExtentY = 873 _Version = 393216 LargeChange = 1000 SmallChange = 100 Min = -10000 Max = 10000 TickFrequency = 1000 End Begin VB.Label lblRange AutoSize = -1 'True Caption = "0" Height = 195 Index = 1 Left = 2400 TabIndex = 23 Top = 1680 Width = 90 End Begin VB.Label Label2 AutoSize = -1 'True Caption = "Range End:" Height = 195 Left = 1440 TabIndex = 22 Top = 1680 Width = 855 End Begin VB.Label lblRange AutoSize = -1 'True Caption = "0" Height = 195 Index = 0 Left = 2400 TabIndex = 21 Top = 600 Width = 90 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "Range Start:" Height = 195 Left = 1440 TabIndex = 20 Top = 600 Width = 900 End End Begin VB.Frame frameConstantForce Caption = "Constant Force" Height = 3015 Left = 120 TabIndex = 13 Top = 240 Visible = 0 'False Width = 5175 Begin MSComctlLib.Slider sldConstantForce Height = 495 Left = 840 TabIndex = 14 Top = 1320 Width = 3615 _ExtentX = 6376 _ExtentY = 873 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 SelStart = 10000 TickFrequency = 1000 Value = 10000 End Begin VB.Label lblConstantForce AutoSize = -1 'True Caption = "10000" Height = 195 Left = 3360 TabIndex = 16 Top = 1080 Width = 450 End Begin VB.Label Label5 AutoSize = -1 'True Caption = "Constant Force Magnitude:" Height = 195 Left = 1320 TabIndex = 15 Top = 1080 Width = 1920 End End End Begin VB.Frame frmGeneral Caption = "General Parameters" Height = 2895 Left = 120 TabIndex = 1 Top = 3960 Width = 3375 Begin MSComctlLib.Slider sldDuration Height = 495 Left = 240 TabIndex = 2 Top = 600 Width = 2775 _ExtentX = 4895 _ExtentY = 873 _Version = 393216 LargeChange = 100 SmallChange = 10 Min = 1 Max = 50001 SelStart = 50001 TickFrequency = 5000 Value = 50001 End Begin MSComctlLib.Slider sldGain Height = 495 Left = 240 TabIndex = 5 Top = 1320 Width = 2775 _ExtentX = 4895 _ExtentY = 873 _Version = 393216 LargeChange = 100 SmallChange = 10 Max = 10000 SelStart = 10000 TickFrequency = 1000 Value = 10000 End Begin MSComctlLib.Slider sldSamplePeriod Height = 495 Left = 240 TabIndex = 9 Top = 2160 Width = 2775 _ExtentX = 4895 _ExtentY = 873 _Version = 393216 LargeChange = 1000 SmallChange = 100 Max = 100000 TickFrequency = 10000 End Begin VB.Label lblSamplePeriod AutoSize = -1 'True Caption = "Default" Height = 195 Left = 1320 TabIndex = 11 Top = 1920 Width = 510 End Begin VB.Label Label6 AutoSize = -1 'True Caption = "Sample rate:" Height = 195 Left = 360 TabIndex = 10 Top = 1920 Width = 885 End Begin VB.Label lblGain AutoSize = -1 'True Caption = "10000" Height = 195 Left = 1200 TabIndex = 7 Top = 1080 Width = 450 End Begin VB.Label Label4 AutoSize = -1 'True Caption = "Effect gain:" Height = 195 Left = 360 TabIndex = 6 Top = 1080 Width = 810 End Begin VB.Label lblDuration AutoSize = -1 'True Caption = "Infinite" Height = 195 Left = 1560 TabIndex = 4 Top = 360 Width = 465 End Begin VB.Label Label3 AutoSize = -1 'True Caption = "Effect Duration:" Height = 195 Left = 360 TabIndex = 3 Top = 360 Width = 1110 End End Begin VB.ListBox lstEffects Height = 3375 Left = 120 TabIndex = 0 Top = 360 Width = 3375 End Begin VB.Label lblAvailable AutoSize = -1 'True Caption = "Available effects:" Height = 195 Left = 120 TabIndex = 8 Top = 120 Width = 1215 End Attribute VB_Name = "frmForceFeedback" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved. ' File: ForceFeedback.frm ' Content: Demonstrates the use of force feedback using ' stock dinput effects ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit Dim dx As New DirectX8 'DirectX 8 object Dim di As DirectInput8 'DirectInput object Dim diJoystick As DirectInputDevice8 'DirectInput device object Dim enumDevice As DirectInputEnumDevices8 'DirectInput enumeration for devices object Dim diEnumObjects As DirectInputEnumDeviceObjects 'DirectInput enumeration for objects on a device object Dim diDevObjInstance As DirectInputDeviceObjectInstance 'DirectInput object on a device object Dim diEffEnum As DirectInputEnumEffects 'DirectInput enumeration for force feedback effects object Dim diFFEffect() As DirectInputEffect 'Force feedback effects object Dim diEffectType As Long 'Will be used to store the type of effect an effect object is Dim diFFStaticParams As Long 'Will be used to store the static parameters of an effect object Dim EffectParams() As Long 'Used to store the type of effect it is Dim Caps As DIDEVCAPS 'Will be used to store the capabilities of the diJoystick Dim lngLastEffectIndex As Long 'Will be used to store the last effect Dim bInit As Boolean Private Function CreateFFEffect(Index As Integer) As DIEFFECT 'This sub creates a generic effect DIEFFECT structure to be used in creating the effect With CreateFFEffect .lDuration = &HFFFFFFFF 'Infinite duration .lGain = 10000 'Full gain .lSamplePeriod = 1000 'Default sample period .lTriggerButton = DIEB_NOTRIGGER 'Do Not require a trigger for the effects .lTriggerRepeatInterval = -1 'Turn off trigger repeat interval .constantForce.lMagnitude = 10000 'Make the magnitude of a constant force effect at full .rampForce.lRangeStart = 0 'Make the magnitude at the start of a ramp force 0 .rampForce.lRangeEnd = 0 'Make the magnitude at the end of a ramp force 0 .conditionFlags = DICONDITION_USE_BOTH_AXES 'Use both axis when using a conditional force With .conditionX 'For the X axis .lDeadBand = 0 'Make an effect with no deadband .lNegativeSaturation = 10000 'Turn the negative saturation all the way up .lOffset = 0 'Zero the offset .lPositiveSaturation = 10000 'Turn the positive saturation all the way up End With With .conditionY 'For the Y axis .lDeadBand = 0 'Make an effect with no deadband .lNegativeSaturation = 10000 'Turn the negative saturation all the way up .lOffset = 0 'Zero the offset .lPositiveSaturation = 10000 'Turn the positive saturation all the way up End With With .periodicForce 'For a periodic force .lMagnitude = 10000 'Turn the magnitude of the force all the way up .lOffset = 0 'Zero the offset .lPeriod = 0 'Set the length of a cycle to 0. This tells the driver to use the default. .lPhase = 0 'Zero the starting phase. Phase is something that has very 'limited support, so changing this parameter will almost always 'fail. Be prepared to catch the error this will return. End With End With End Function Private Sub chkEnvelope_Click() Call ChangeParameter("envelope") 'Call the sub to change the parameters for the envelope of the effect. End Sub Private Sub Form_Activate() Dim i As Long 'Count variable Dim j As Integer 'Count variable Dim prop As DIPROPLONG 'Device property structure Dim diedo As DirectInputEnumDeviceObjects 'Holds the collection of individual objects on a device Dim didoi As DirectInputDeviceObjectInstance 'Holds the instance of an object on a device Dim lFFAxisCount As Long 'Holds the number of axis that support FF Set di = dx.DirectInputCreate 'Create the direct input device Set enumDevice = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY Or DIEDFL_FORCEFEEDBACK) 'Enumerate all joysticks that are attached to the system For i = 1 To enumDevice.GetCount Set diJoystick = di.CreateDevice(enumDevice.GetItem(i).GetGuidInstance) diJoystick.GetCapabilities Caps 'Get the capabilites of the device Set diedo = diJoystick.GetDeviceObjectsEnum(DIDFT_AXIS) ' Get info about all the axis on the device 'This loops through to make sure that there 'are at least two axis that support FF For j = 1 To diedo.GetCount Set didoi = diedo.GetItem(j) If (didoi.GetFlags And DIDOI_FFACTUATOR) Then lFFAxisCount = lFFAxisCount + 1 End If Next If lFFAxisCount > 1 Then diJoystick.SetCommonDataFormat DIFORMAT_JOYSTICK 'Set the format of the device to that of a joystick diJoystick.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_EXCLUSIVE 'Set the cooperative level of the device as an exclusive 'background device, and attach it to the form's hwnd prop.lData = 0 prop.lHow = DIPH_DEVICE prop.lObj = 0 Call diJoystick.SetProperty("DIPROP_AUTOCENTER", prop) 'Turn off autocenter diJoystick.Acquire 'Make sure to aquire the device Set diEffEnum = diJoystick.GetEffectsEnum(DIEFT_ALL) 'Enumerate all the available effects For j = 1 To diEffEnum.GetCount 'Loop through all the effects diEffectType = diEffEnum.GetType(j) And &HFF 'Filter out the major type of effect it is diFFStaticParams = diEffEnum.GetStaticParams(j) 'Get the static parameters of this effect If (diEffectType = DIEFT_HARDWARE) And _ (diFFStaticParams And DIEP_TYPESPECIFICPARAMS) <> 0 Then 'If this is a hardware effect that has type-specific parameters, GoTo Ignore 'ignore it and skip to the next effect ElseIf diEffectType = DIEFT_CUSTOMFORCE Then 'If this effect is a custom effect, GoTo Ignore 'ignore it and skip to the next effect End If lstEffects.AddItem diEffEnum.GetName(j) 'Add this effect to the listbox, displaying the name of the 'effect ReDim Preserve EffectParams(lstEffects.ListCount - 1) 'Redimension the array that stores the type of effect this 'effect is EffectParams(lstEffects.ListCount - 1) = diEffectType 'store the type of effect in the EffectParams array ReDim Preserve diFFEffect(lstEffects.ListCount - 1) 'Redimension the effect object array On Local Error GoTo ErrorHandler 'Catch any errors when creating the effect object Set diFFEffect(UBound(diFFEffect)) = diJoystick.CreateEffect(diEffEnum.GetEffectGuid(j), _ CreateFFEffect(j)) 'Create the effect, using the return value from the 'CreateFFEffect function, which returns a generic effect 'structure diFFEffect(UBound(diFFEffect)).Unload 'Since creating an effect automtically downloads it, unload 'it so we don't run out of room on the device. Ignore: Next Exit For 'Keep the first FF joystick found Else Set diJoystick = Nothing 'Destroy this device and try again if there are more devices End If Next If diJoystick Is Nothing Then 'If no FF joystick is found attached to the system MsgBox "No force feedback joystick attached, app will exit" 'Display this message Unload Me 'Unload the form End 'End the program End If If diFFEffect(0) Is Nothing Then 'If this device has no downloadable effects, end the app MsgBox "This device does not contain any downloadable effects, app will exit" Unload Me 'Unload the form End 'End the program End If lngLastEffectIndex = UBound(diFFEffect) 'Store the ubound of the effect array as the last effect accessed bInit = True lstEffects.ListIndex = 0 'make the first index of the listbox selected Exit Sub 'Exit the sub ErrorHandler: 'Handle any errors that occur when trying to create an effect object If Err.Number = 5 Then 'If this is an effect that isn't able to be loaded If lstEffects.ListCount > 0 Then lstEffects.RemoveItem lstEffects.ListCount - 1 'Remove the item from the list If (lstEffects.ListCount > 0) Then ReDim Preserve diFFEffect(lstEffects.ListCount - 1) 'Redimension the array since this effect will not be included ReDim Preserve EffectParams(lstEffects.ListCount - 1) 'Redimension the effect params array as well Else Erase diFFEffect Erase EffectParams End If End If Err.Clear GoTo Ignore 'Skip this effect ElseIf Err.Number = DIERR_NOTEXCLUSIVEACQUIRED Then 'If the program loses exclusive use of the joystick, diJoystick.Unacquire 'Unacquire the joystick diJoystick.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_EXCLUSIVE 'Set the cooperative level again diJoystick.Acquire 'Acquire the joystick again Resume 'Resume execution on that line again, since the program 'now has control of the joystick End If End Sub Private Sub lstEffects_Click() If bInit = False Then Exit Sub 'This sub unloads the last effect, downloads the new one, stores the index in the last effect variable, and 'calls the sub to update all the frames and controls on the form Dim EffectInfo As DIEFFECT 'Dim a DIEFFECT structure On Local Error GoTo ErrorHandler 'Catch any errors while unloading/downloading effects diFFEffect(lngLastEffectIndex).Unload 'Unload the last effect diFFEffect(lstEffects.ListIndex).Start 1, 0 'Start the effect playing (this will also download the effect) lngLastEffectIndex = lstEffects.ListIndex 'Store this list index in the lasteffectindex variable Call UpdateFrames 'Call the sub that updates all the frames and the controls 'they contain on the form Exit Sub ErrorHandler: 'Handle any errors If Err.Number = DIERR_NOTEXCLUSIVEACQUIRED Then 'If the program loses exclusive use of the joystick, diJoystick.Unacquire 'Unacquire the joystick diJoystick.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_EXCLUSIVE 'Set the cooperative level again diJoystick.Acquire 'Acquire the joystick again Resume 'Resume execution on that line again, since the program 'now has control of the joystick End If End Sub Private Sub ChangeParameter(Param As String) On Local Error GoTo ErrorHandler 'This sub changes the specified parameter If lstEffects.ListIndex = -1 Then Exit Sub Dim EffectInfo As DIEFFECT 'Dim a DIEFFECT structure diFFEffect(lstEffects.ListIndex).GetParameters EffectInfo 'Get the parameters of this effect On Local Error GoTo ErrorHandler 'If there are any errors that occur, trap them Select Case Param 'Select the string value passed to the sub Case "duration" 'If duration is being changed If sldDuration = 50001 Then 'If the slider's value is at 50,001 EffectInfo.lDuration = -1 'Then make the effect have an infinite duration Else 'Otherwise EffectInfo.lDuration = sldDuration * 100 'Multiply the slider's value by 100 to convert to microseconds End If diFFEffect(lstEffects.ListIndex).Stop diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_DURATION 'Set the new parameter, specifiying the duration is what needs 'to be changed diFFEffect(lstEffects.ListIndex).Start 1, 0 Case "gain" 'If gain is the parameter to be changed, EffectInfo.lGain = sldGain 'Set the effect info element lGain to the value of the gain slider diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_GAIN 'Set the new gain Case "samplerate" 'The sample rate is the parameter to be changed EffectInfo.lSamplePeriod = sldSamplePeriod 'Set the effectinfo lSamplePeriod to the value of the sample period slider diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_SAMPLEPERIOD 'Set the parameter Case "constantforcemagnitude" 'If the constant force magnitude is to be changed EffectInfo.constantForce.lMagnitude = sldConstantForce 'Set the constant force element to the value of the constant 'force slider diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_TYPESPECIFICPARAMS 'Change the parameter Case "rampforce" 'If ramp force is the parameter to change EffectInfo.rampForce.lRangeStart = sldRampRange(0).Value 'Set the start range to the range slider(0) value EffectInfo.rampForce.lRangeEnd = sldRampRange(1).Value 'Set the end range to the range slider(1) value diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_TYPESPECIFICPARAMS 'Set the parameters Case "periodic" 'If a periodic effect parameter needs to be changed With EffectInfo.periodicForce .lMagnitude = sldPeriodic(0) 'set the magnitude .lOffset = sldPeriodic(1) 'the offset .lPhase = sldPeriodic(2) 'the phase (this is almost always going to fail, there aren't 'a lot of drivers that will support this) .lPeriod = sldPeriodic(3) 'the period of the effect End With diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_TYPESPECIFICPARAMS 'set the parameters Case "condition" 'If it is a conditional effect parameter If optConditionAxis(0) Then 'If the X axis is selected With EffectInfo.conditionX 'Update the X axis condition information .lDeadBand = sldCondition(0) 'set the deadband .lNegativeCoefficient = sldCondition(1) 'set the negative coefficient .lNegativeSaturation = sldCondition(2) 'set the negative saturation .lOffset = sldCondition(3) 'set the offset .lPositiveCoefficient = sldCondition(4) 'set the positive coefficient .lPositiveSaturation = sldCondition(5) 'set the positive saturation End With Else 'Otherwise, the Y axis is being set With EffectInfo.conditionY .lDeadBand = sldCondition(0) 'set the deadband .lNegativeCoefficient = sldCondition(1) 'set the negative coefficient .lNegativeSaturation = sldCondition(2) 'set the negative saturation .lOffset = sldCondition(3) 'set the offset .lPositiveCoefficient = sldCondition(4) 'set the positive coefficient .lPositiveSaturation = sldCondition(5) 'set the positive saturation End With End If diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_TYPESPECIFICPARAMS 'set the parameters Case "envelope" 'the envelope needs to be changed If chkEnvelope.Value = 1 Then 'if the envelope checkbox is checked With EffectInfo .bUseEnvelope = True 'let DirectInput know this effect has an envelope With .envelope .lAttackLevel = sldEnvelope(0) 'set the attack level .lAttackTime = sldEnvelope(1) 'set the attack time .lFadeLevel = sldEnvelope(2) 'set the fade level .lFadeTime = sldEnvelope(3) 'set the fade time End With End With diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_ENVELOPE 'Set the new parameters Else EffectInfo.bUseEnvelope = False 'Otherwise, let DirectInput know that this effect doesn't use an envelope diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_ENVELOPE 'Set the parameters to reflect this change End If Case "direction" 'Direction is the parameter that needs to be changed With EffectInfo If optDirection(0) Then 'If the north button is selected .x = 0 'set the effect's direction to come from the north ElseIf optDirection(1) Then 'If the north-east button is selected .x = 4500 'set the effect's direction to come from the north-east ElseIf optDirection(2) Then 'if the east button is selected .x = 9000 'set the effect's direction to come from the east ElseIf optDirection(3) Then 'if the south-east button is selected .x = 13500 'set the effect's direction to come from the south east ElseIf optDirection(4) Then 'if the south button is selected .x = 18000 'set the effect's direction to come from the south ElseIf optDirection(5) Then 'if the south-west button is selected .x = 22500 'set the effect's direction to come from the south-west ElseIf optDirection(6) Then 'if the west button is selected .x = 27000 'set the effect's direction to come from the west ElseIf optDirection(7) Then 'if the north-west button is selected .x = 31500 'set the effects's direction to come from the north-west End If End With diFFEffect(lstEffects.ListIndex).SetParameters EffectInfo, DIEP_DIRECTION 'set the parameters End Select Exit Sub ErrorHandler: 'if an error is encountered while setting a parameter If Err.Number = 445 Then 'If the object doesn't support this action then MsgBox "The parameter cannot be set to this value for this effect type" 'display this message ElseIf Err.Number = DIERR_NOTEXCLUSIVEACQUIRED Then 'If the program loses exclusive use of the joystick, diJoystick.Unacquire 'Unacquire the joystick diJoystick.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_EXCLUSIVE 'Set the cooperative level again diJoystick.Acquire 'Acquire the joystick again Resume 'Resume execution on that line again, since the program 'now has control of the joystick End If End Sub Private Sub UpdateFrames() 'This sub updates all the frames and controls the frame contains on the form, with the values in the 'currently selected effect Dim EffType As DIEFFECT 'dim a DIEFFECT structure frameConstantForce.Visible = False ' frameRampForce.Visible = False 'Hide all type-specific frames framePeriodic.Visible = False ' frameCondition.Visible = False ' diFFEffect(lstEffects.ListIndex).GetParameters EffType 'get the parameters of the effect optDirection(EffType.x \ 4500).Value = True 'make sure the correct direction is displayed If EffType.bUseEnvelope = True Then 'if this effect is using an envelope chkEnvelope.Value = 1 'make sure the envelope checkbox is checked sldEnvelope(0).Value = EffType.envelope.lAttackLevel 'display the attack level sldEnvelope(1).Value = EffType.envelope.lAttackTime 'display the attack time sldEnvelope(2).Value = EffType.envelope.lFadeLevel 'display the fade level sldEnvelope(3).Value = EffType.envelope.lFadeTime 'display the fade time Else 'otherwise chkEnvelope.Value = 0 ' sldEnvelope(0).Value = 0 'Zero everything out sldEnvelope(1).Value = 0 ' sldEnvelope(2).Value = 0 ' sldEnvelope(3).Value = 0 ' End If If EffType.lDuration = -1 Then 'If the effect duration is infinite sldDuration = 50001 'make sure the slider reflects this Else 'otherwise sldDuration = EffType.lDuration \ 100 'set the slider to the milliseconds End If sldGain = EffType.lGain 'display the gain sldSamplePeriod = EffType.lSamplePeriod 'display the sample period sldConstantForce = EffType.constantForce.lMagnitude 'display the constant force magnitude sldRampRange(0) = EffType.rampForce.lRangeStart 'display the range start of the ramp force sldRampRange(1) = EffType.rampForce.lRangeEnd 'display the range end of the ramp force sldPeriodic(0) = EffType.periodicForce.lMagnitude 'display the magnitude of the periodic force sldPeriodic(1) = EffType.periodicForce.lOffset 'display the offset of the periodic force sldPeriodic(2) = EffType.periodicForce.lPhase 'display the phase of the periodic force sldPeriodic(3) = EffType.periodicForce.lPeriod 'display the period of the periodic force If optConditionAxis(0) Then 'if the X axis option button is selected sldCondition(0) = EffType.conditionX.lDeadBand 'display the deadband value sldCondition(1) = EffType.conditionX.lNegativeCoefficient 'display the neg. coefficient sldCondition(2) = EffType.conditionX.lNegativeSaturation 'display the neg. saturation sldCondition(3) = EffType.conditionX.lOffset 'display the offset sldCondition(4) = EffType.conditionX.lPositiveCoefficient 'display the pos. coefficient sldCondition(5) = EffType.conditionX.lPositiveSaturation 'display the pos. saturation Else 'otherwise, display all the info for the Y axis sldCondition(0) = EffType.conditionY.lDeadBand 'display the deadband value sldCondition(1) = EffType.conditionY.lNegativeCoefficient 'display the neg. coefficient sldCondition(2) = EffType.conditionY.lNegativeSaturation 'display the neg. saturation sldCondition(3) = EffType.conditionY.lOffset 'display the offset sldCondition(4) = EffType.conditionY.lPositiveCoefficient 'display the pos. coefficient sldCondition(5) = EffType.conditionY.lPositiveSaturation 'display the pos. saturation End If Select Case EffectParams(lstEffects.ListIndex) 'Get the effect type of this effect from the type stored in 'the array. Case DIEFT_CONSTANTFORCE 'If this is a constant force effect frameConstantForce.Visible = True 'display the constant force frame Case DIEFT_RAMPFORCE 'If this is a ramp force effect frameRampForce.Visible = True 'Show the ramp force frame Case DIEFT_PERIODIC 'If this is a square force framePeriodic.Visible = True 'show the periodic effect frame Case DIEFT_CONDITION 'if this is a spring effect frameCondition.Visible = True 'show the condition frame Case Else 'this effect is a hardware effect with no type-specific parameters End Select End Sub Private Sub optConditionAxis_Click(Index As Integer) Call UpdateFrames 'Update the frames End Sub Private Sub optDirection_Click(Index As Integer) Call ChangeParameter("direction") 'Change the direction parameter End Sub Private Sub sldCondition_Change(Index As Integer) lblCondition(Index) = sldCondition(Index) 'display the value in the label Call ChangeParameter("condition") 'change the condition parameter End Sub Private Sub sldCondition_Scroll(Index As Integer) lblCondition(Index) = sldCondition(Index) 'display the value in the label Call ChangeParameter("condition") 'change the condition parameter End Sub Private Sub sldConstantForce_Change() lblConstantForce = sldConstantForce 'display the value Call ChangeParameter("constantforcemagnitude") 'change the parameter End Sub Private Sub sldDuration_Change() lblDuration = sldDuration \ 10 & " Milliseconds" 'show the value in milliseconds If sldDuration = 50001 Then lblDuration = "Infinite" 'if the value is 50,001 make sure that infinite is displayed Call ChangeParameter("duration") 'change the duration parameter End Sub Private Sub sldDuration_Scroll() lblDuration = sldDuration \ 10 & " Milliseconds" 'show the value in milliseconds If sldDuration = 50001 Then lblDuration = "Infinite" 'if the value is 50,001 make sure that infinite is displayed Call ChangeParameter("duration") 'change the duration parameter End Sub Private Sub sldEnvelope_Change(Index As Integer) lblEnvelope(Index) = sldEnvelope(Index) \ 1000 'show the value in milliseconds If chkEnvelope.Value = 1 Then 'if the envelope check box is checked Call ChangeParameter("envelope") 'change the envelope parameter End If End Sub Private Sub sldEnvelope_Scroll(Index As Integer) lblEnvelope(Index) = sldEnvelope(Index) \ 1000 'show the value in milliseconds If chkEnvelope.Value = 1 Then 'if the envelope check box is checked Call ChangeParameter("envelope") 'change the envelope parameter End If End Sub Private Sub sldGain_Change() lblGain = sldGain 'show the value Call ChangeParameter("gain") 'change the parameter End Sub Private Sub sldGain_Scroll() lblGain = sldGain 'show the value Call ChangeParameter("gain") 'change the parameter End Sub Private Sub sldPeriodic_Change(Index As Integer) lblPeriodic(Index) = sldPeriodic(Index) 'show the value Call ChangeParameter("periodic") 'change the parameter End Sub Private Sub sldrampRange_Change(Index As Integer) lblRange(Index) = sldRampRange(Index).Value 'show the value Call ChangeParameter("rampforce") 'change the parameter End Sub Private Sub sldSamplePeriod_Change() If sldSamplePeriod = 0 Then 'if the sample period is 0, lblSamplePeriod = "Default" 'display that it is the default Else 'otherwise lblSamplePeriod = sldSamplePeriod 'display the sample period End If Call ChangeParameter("samplerate") 'change the parameter End Sub Private Sub sldSamplePeriod_Scroll() If sldSamplePeriod = 0 Then 'if the sample period is 0, lblSamplePeriod = "Default" 'display that it is the default Else 'otherwise lblSamplePeriod = sldSamplePeriod 'display the sample period End If Call ChangeParameter("samplerate") 'change the parameter End Sub